home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 12 / Cream of the Crop 12 (Part II) / Cream of the Crop 12 (Part II).iso / OS2 / FCHEK284.ZIP / project.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-03-29  |  26.1 KB  |  932 lines
  1.  
  2. /* project.c:
  3.     Project-file I/O routines.  Routines included:
  4.  
  5.     Shared routines:
  6.        void proj_file_out() writes data from symbol table to project file.
  7.        void proj_file_in() reads data from project file to symbol table.
  8.  
  9.     Private routines:
  10.         int has_defn()        TRUE if external has defn in current file
  11.         int has_call()        TRUE if external has call in current file
  12.         int count_com_defns() Counts multiple common defns.
  13.         void proj_alist_out() Outputs argument lists
  14.         void proj_clist_out() Outputs common lists
  15.         void proj_arg_info_in()  Inputs argument lists
  16.         void proj_com_info_in()  Inputs common lists
  17. */
  18.  
  19. #include <stdio.h>
  20. #include <string.h>
  21. #include "ftnchek.h"
  22. #define PROJECT
  23. #include "symtab.h"
  24. #include <string.h>
  25.  
  26. SYM_SHARED char *
  27. new_global_string();        /* located in symtab.c */
  28.  
  29. PRIVATE char
  30.     *getstrn();
  31.  
  32. /* Note: compilation option PROJ_KEEPALL
  33.  
  34.    Define the symbol PROJ_KEEPALL to make Ftnchek create project files
  35.    with complete global symbol table information.  Otherwise, the default
  36.    action is: in library mode, keep only subprogram definitions, those
  37.    external references not defined in the current file, and only one
  38.    instance of each common block.  In non-library mode, the default is to
  39.    keep, besides the above, one call of a given routine from each module,
  40.    and all common block declarations.
  41.    PROJ_KEEPALL is useful mainly for debugging purposes.
  42. */
  43. #define PROJFILE_COOKIE "FTNCHEK_" /* first part of magic cookie */
  44.  
  45. PRIVATE int has_defn(), has_call();
  46. PRIVATE void proj_alist_out(),proj_clist_out(),
  47.   proj_arg_info_in(),proj_com_info_in();
  48.  
  49. PRIVATE int count_com_defns();
  50.  
  51. PRIVATE int
  52. has_defn(alist)            /* Returns TRUE if list has defns */
  53.    ArgListHeader *alist;
  54. {
  55.   while( alist != NULL && alist->topfile == top_filename ) {
  56.     if(alist->is_defn)
  57.       return TRUE;
  58.     alist = alist->next;
  59.   }
  60.   return FALSE;
  61. }
  62.  
  63.  
  64. PRIVATE int
  65. has_call(alist)        /* Returns TRUE if list has calls or defns  */
  66.    ArgListHeader *alist;
  67. {
  68.   while( alist != NULL && alist->topfile == top_filename) {
  69.     if( alist->is_call || alist->actual_arg )
  70.     return TRUE;
  71.     alist = alist->next;
  72.   }
  73.   return FALSE;
  74. }
  75.  
  76. PRIVATE int
  77. count_com_defns(clist)        /* Returns number of common decls in list  */
  78.    ComListHeader *clist;
  79. {
  80.   int count=0;
  81.   while( clist != NULL && clist->topfile == top_filename ) {
  82.     ++count;
  83.     clist = clist->next;
  84.   }
  85.   return count;
  86. }
  87.  
  88.  
  89.     /* proj_file_out: writes data from symbol table to project file. */
  90.  
  91. #define WRITE_STR(LEADER,S)    (void)(fprintf(fd,LEADER), fprintf(fd," %s",S))
  92. #define WRITE_ARG(LEADER,S)    (void)(fprintf(fd,LEADER), fprintf(fd," %s",S))
  93. #define WRITE_NUM(LEADER,NUM)    (void)(fprintf(fd,LEADER), fprintf(fd," %ld",NUM))
  94. #define NEXTLINE        (void)fprintf(fd,"\n")
  95.  
  96. void
  97. proj_file_out(fd)
  98.      FILE *fd;
  99. {
  100.   Gsymtab *sym_list[GLOBSYMTABSZ]; /* temp. list of symtab entries to print */
  101.   BYTE sym_has_defn[GLOBSYMTABSZ];
  102.   BYTE sym_has_call[GLOBSYMTABSZ];
  103.  
  104.   if(fd == NULL)
  105.     return;
  106.  
  107.   WRITE_STR(PROJFILE_COOKIE,PROJECT_VERSION); /* magic cookie */
  108.   NEXTLINE;
  109.  
  110.   WRITE_STR("file",top_filename);
  111.   NEXTLINE;
  112.  
  113.   {    /* Make list of subprograms defined or referenced in this file */
  114.     int i,numexts,numdefns,numcalls,do_defns,pass;
  115.     ArgListHeader *alist;
  116.     for(i=0,numexts=numdefns=numcalls=0;i<glob_symtab_top;i++) {
  117.       if(storage_class_of(glob_symtab[i].type) == class_SUBPROGRAM &&
  118.     (alist=glob_symtab[i].info.arglist) != NULL) {
  119.             /* Look for defns and calls of this guy. */
  120.  
  121.     if( (sym_has_defn[numexts]=has_defn(alist)) != (BYTE) FALSE )
  122.        numdefns++;
  123.     if( (sym_has_call[numexts]= (has_call(alist)
  124.         /* keep only externals not satisfied in this file */
  125. #ifndef PROJ_KEEPALL
  126.             && (!library_mode || !sym_has_defn[numexts])
  127. #endif
  128.                   )) != (BYTE) FALSE )
  129.        numcalls++;
  130.     if(sym_has_defn[numexts] || sym_has_call[numexts])
  131.       sym_list[numexts++] = &glob_symtab[i];
  132.       }
  133.     }
  134.  
  135.         /* List all subprogram defns, then all calls */
  136.     for(pass=0,do_defns=TRUE; pass<2; pass++,do_defns=!do_defns) {
  137.  
  138.       if(do_defns)
  139.     WRITE_NUM(" entries",(long)numdefns);
  140.       else
  141.     WRITE_NUM(" externals",(long)numcalls);
  142.       NEXTLINE;
  143.  
  144.       for(i=0; i<numexts; i++) {
  145.     if( (do_defns && sym_has_defn[i]) || (!do_defns && sym_has_call[i]) ){
  146.       if(do_defns)
  147.         WRITE_STR(" entry",sym_list[i]->name);
  148.       else
  149.         WRITE_STR(" external",sym_list[i]->name);
  150.  
  151.       WRITE_NUM(" class",(long)storage_class_of(sym_list[i]->type));
  152.       WRITE_NUM(" type",(long)datatype_of(sym_list[i]->type));
  153.       WRITE_NUM(" size",(long)sym_list[i]->size);
  154.       (void)fprintf(fd," flags %d %d %d %d %d %d %d %d",
  155.           sym_list[i]->used_flag,
  156.           sym_list[i]->set_flag,
  157.           sym_list[i]->invoked_as_func,
  158.           sym_list[i]->declared_external,
  159.           /* N.B. library_module included here but is not restored */
  160.           sym_list[i]->library_module,
  161.           0,    /* Flags for possible future use */
  162.           0,
  163.           0);
  164.       NEXTLINE;
  165.       proj_alist_out(sym_list[i],fd,do_defns,(int)sym_has_defn[i]);
  166.     }
  167.       }/* end for i */
  168.       NEXTLINE;
  169.     }/*end for pass */
  170.   }
  171.  
  172.   {
  173.     int i,numblocks,numdefns;
  174.     ComListHeader *clist;
  175.     for(i=0,numblocks=numdefns=0;i<glob_symtab_top;i++) {
  176.       if(storage_class_of(glob_symtab[i].type) == class_COMMON_BLOCK
  177.      && (clist=glob_symtab[i].info.comlist) != NULL &&
  178.      clist->topfile == top_filename ) {
  179. #ifndef PROJ_KEEPALL
  180.             /* No keepall: save only one com decl if -lib mode */
  181.     if(library_mode)
  182.       numdefns++;
  183.     else
  184. #endif            /* keepall or -nolib mode: keep all com decls */
  185.       numdefns += count_com_defns(clist);
  186.  
  187.     sym_list[numblocks++] = &glob_symtab[i];
  188.       }
  189.     }
  190.     WRITE_NUM(" comblocks",(long)numdefns);
  191.     NEXTLINE;
  192.     for(i=0; i<numblocks; i++) {
  193.       proj_clist_out(sym_list[i],fd);
  194.     }
  195.     NEXTLINE;
  196.   }
  197. }
  198.  
  199.  
  200.  
  201.  
  202.     /* proj_alist_out: writes arglist data from symbol table to
  203.        project file. */
  204.  
  205. PRIVATE void
  206. proj_alist_out(gsymt,fd,do_defns,locally_defined)
  207.      Gsymtab *gsymt;
  208.      FILE *fd;
  209.      int do_defns,locally_defined;
  210. {
  211.   ArgListHeader *a=gsymt->info.arglist;
  212.   ArgListElement *arg;
  213.   int i,n;
  214.   unsigned long diminfo;
  215.   Gsymtab *last_calling_module;
  216.  
  217.  
  218.         /* This loop runs thru only those arglists that were
  219.             created in the current top file. */
  220.     last_calling_module = NULL;
  221.     while( a != NULL && a->topfile == top_filename) {
  222.         /* do_defns mode: output only definitions */
  223.      if( (do_defns && a->is_defn) || (!do_defns && !a->is_defn) )
  224. #ifndef PROJ_KEEPALL
  225.         /* keep only externals not satisfied in this file in -lib
  226.            mode, otherwise keep one actual call from each module. */
  227.     if( a->is_defn
  228.        || !locally_defined
  229.        || (!library_mode && (a->is_call || a->actual_arg)
  230.        && a->module != last_calling_module))
  231. #endif
  232.      {
  233.       last_calling_module = a->module;
  234.       if(a->is_defn)
  235.      (void)fprintf(fd," defn\n");
  236.       else
  237.      (void)fprintf(fd," call\n");
  238.  
  239.       WRITE_STR(" module",a->module->name);
  240.       WRITE_STR(" file",a->filename);
  241.       WRITE_NUM(" line",(long)a->line_num);
  242.       WRITE_NUM(" top",(long)a->top_line_num);
  243.       WRITE_NUM(" class",(long)storage_class_of(a->type));
  244.       WRITE_NUM(" type",(long)datatype_of(a->type));
  245.       WRITE_NUM(" size",(long)a->size);
  246.       (void)fprintf(fd," flags %d %d %d %d",
  247.           a->is_defn,
  248.           a->is_call,
  249.           a->external_decl,
  250.           a->actual_arg);
  251.       NEXTLINE;
  252.       n=a->numargs;
  253.       if(a->is_defn || a->is_call) {
  254.     WRITE_NUM(" args",(long)n);
  255.     NEXTLINE;
  256.       }
  257.  
  258.       /* Next lines, 2 per argument.
  259.        1st line: position number & name or source text of expr
  260.        2nd line: type, array dims, array size, flags
  261.        */
  262.       arg = a->arg_array;
  263.       for(i=0; i<n; i++) {
  264.     WRITE_NUM(" arg",(long)i+1);
  265.     WRITE_ARG(" name",arg[i].name);
  266.     NEXTLINE;
  267.     WRITE_NUM(" class",(long)storage_class_of(arg[i].type));
  268.     WRITE_NUM(" type",(long)datatype_of(arg[i].type));
  269.     WRITE_NUM(" size",(long)arg[i].size);
  270.     diminfo = (
  271.            ((storage_class_of(arg[i].type) == class_VAR) &&
  272.            is_computational_type(datatype_of(arg[i].type))) ?
  273.              arg[i].info.array_dim: 0 );
  274.     WRITE_NUM(" dims",(long)array_dims(diminfo));
  275.     WRITE_NUM(" elts",(long)array_size(diminfo));
  276.     (void)fprintf(fd," flags %d %d %d %d %d %d %d %d",
  277.         arg[i].is_lvalue,
  278.         arg[i].set_flag,
  279.         arg[i].assigned_flag,
  280.         arg[i].used_before_set,
  281.         arg[i].array_var,
  282.         arg[i].array_element,
  283.         arg[i].declared_external,
  284.         0);        /* possible flag for future use */
  285.     NEXTLINE;
  286.       }
  287.      }/* end if(do_defn...)*/
  288.      a = a->next;
  289.    }/* end while(a!=NULL)*/
  290.    (void)fprintf(fd," end\n");
  291. }/*proj_alist_out*/
  292.  
  293.  
  294.  
  295.     /* proj_clist_out writes common var list data from symbol
  296.        table to project file. */
  297.  
  298. PRIVATE void
  299. proj_clist_out(gsymt,fd)
  300.      Gsymtab *gsymt;
  301.      FILE *fd;
  302. {
  303.     ComListHeader *c=gsymt->info.comlist;
  304.     ComListElement *cvar;
  305.     int i,n;
  306.  
  307.     while( c != NULL && c->topfile == top_filename ) {
  308.  
  309.       WRITE_STR(" block",gsymt->name);
  310.       WRITE_NUM(" class",(long)storage_class_of(gsymt->type));
  311.       WRITE_NUM(" type",(long)datatype_of(gsymt->type));
  312.       NEXTLINE;
  313.       WRITE_STR(" module",c->module->name);
  314.       WRITE_STR(" file",c->filename);
  315.       WRITE_NUM(" line",(long)c->line_num);
  316.       WRITE_NUM(" top",(long)c->top_line_num);
  317.       (void)fprintf(fd," flags %d %d %d %d",
  318.           c->any_used,
  319.           c->any_set,
  320.           c->saved,
  321.           0);        /* Flag for possible future use */
  322.       NEXTLINE;
  323.       WRITE_NUM(" vars",(long)(n=c->numargs));
  324.       NEXTLINE;
  325.  
  326.     /* Next lines, 2 per variable.
  327.          1st line: position number, name.
  328.      2nd line: class, type, array dims, array size
  329.      */
  330.       cvar = c->com_list_array;
  331.       for(i=0; i<n; i++) {
  332.     WRITE_NUM(" var",(long)i+1);
  333.     WRITE_STR(" name",cvar[i].name);
  334.     NEXTLINE;
  335.     WRITE_NUM(" class",(long)storage_class_of(cvar[i].type));
  336.     WRITE_NUM(" type",(long)datatype_of(cvar[i].type));
  337.     WRITE_NUM(" size",(long)cvar[i].size);
  338.     WRITE_NUM(" dims",(long)array_dims(cvar[i].dimen_info));
  339.     WRITE_NUM(" elts",(long)array_size(cvar[i].dimen_info));
  340.     (void)fprintf(fd," flags %d %d %d %d %d %d %d %d",
  341.         cvar[i].used,
  342.         cvar[i].set,
  343.         cvar[i].used_before_set,
  344.         cvar[i].assigned,
  345.         0,        /* possible flags for future use */
  346.         0,
  347.         0,
  348.         0);
  349.       NEXTLINE;
  350.       }
  351.             /* keepall or -nolib: loop thru all defns.
  352.                Otherwise only keep the first. */
  353. #ifndef PROJ_KEEPALL
  354.       if(library_mode)
  355.     break;
  356. #endif
  357.       c = c->next;
  358.     }/* end while c != NULL */
  359. }
  360.  
  361. #undef WRITE_STR
  362. #undef WRITE_NUM
  363. #undef NEXTLINE
  364.  
  365.  
  366.     /* proj_file_in:
  367.        Reads a project file, storing info in global symbol table.
  368.        See proj_file_out and its subroutines for the current
  369.        project file format.
  370.      */
  371. #define MAXNAME 127 /* Max string that will be read in: see READ_STR below */
  372.  
  373.  
  374.             /* Macros for error-flagging input */
  375.  
  376. PRIVATE int nil()/* to make lint happy */
  377. { return 0; }
  378.  
  379. #define READ_ERROR (oops_message(OOPS_FATAL,proj_line_num,NO_COL_NUM,\
  380.      "error reading project file"),nil())
  381. #define READ_OK nil()
  382.  
  383. #define READ_FIRST_STR(LEADER,STR) (fscanf(fd,LEADER), \
  384.                     fscanf(fd,"%127s",STR))
  385. #define READ_STR(LEADER,STR) ((fscanf(fd,LEADER)==0 &&\
  386.                    fscanf(fd,"%127s",STR)==1)? READ_OK:READ_ERROR)
  387. #define READ_ARG(LEADER,STR) ((fscanf(fd,LEADER)==0 && fgetc(fd)==' ' &&\
  388.             (getstrn(STR,MAXNAME+1,fd)!=NULL)==1)? READ_OK:READ_ERROR)
  389. #define READ_NUM(LEADER,NUM) ((fscanf(fd,LEADER)==0 &&\
  390.                    fscanf(fd,"%d",&NUM)==1)? READ_OK:READ_ERROR)
  391. #define READ_LONG(LEADER,NUM) ((fscanf(fd,LEADER)==0 &&\
  392.                    fscanf(fd,"%ld",&NUM)==1)? READ_OK:READ_ERROR)
  393. #define NEXTLINE {int c;while( (c=fgetc(fd)) != EOF && c != '\n') continue;\
  394.             if(c == EOF) READ_ERROR; else ++proj_line_num;}
  395.  
  396.  
  397. PRIVATE unsigned proj_line_num;        
  398.             /* Line number in proj file for diagnostic output */
  399.  
  400. void
  401. proj_file_in(fd)
  402.   FILE *fd;
  403. {
  404.   char buf[MAXNAME+1],*topfilename=NULL;
  405.   int retval;
  406.   unsigned numentries,ientry, numexts,iext, numblocks,iblock;
  407.  
  408.   proj_line_num = 1;
  409.  
  410.  while( (retval=READ_FIRST_STR(PROJFILE_COOKIE,buf)) == 1) {
  411.    if( strcmp(buf,PROJECT_VERSION) != 0 ) {
  412.      (void)fprintf(stderr,
  413.      "\nProject file is not correct version -- must be re-created\n");
  414.      exit(1);
  415.    }
  416.    NEXTLINE;
  417.         /* Save filename in permanent storage */
  418.    READ_STR("file",buf);
  419.    topfilename = new_global_string(buf);
  420.    NEXTLINE;
  421. #ifdef DEBUG_PROJECT
  422.  printf("\nread file %s\n",topfilename);
  423. #endif
  424.  
  425.  
  426.   READ_NUM(" entries",numentries); /* Get no. of entry points */
  427.   NEXTLINE;
  428. #ifdef DEBUG_PROJECT
  429.  printf("read entries %d\n",numentries);
  430. #endif
  431.                 /* Read defn arglists */
  432.   for(ientry=0; ientry<numentries; ientry++) {
  433.       proj_arg_info_in(fd,topfilename,TRUE);
  434.   }
  435.   NEXTLINE;
  436.  
  437.   READ_NUM(" externals",numexts);    /* Get no. of external refs */
  438. #ifdef DEBUG_PROJECT
  439.  printf("read exts %d\n",numexts);
  440. #endif
  441.   NEXTLINE;
  442.  
  443.                 /* Read invocation & ext def arglists */
  444.   for(iext=0; iext<numexts; iext++) {
  445.     proj_arg_info_in(fd,topfilename,FALSE);
  446.   }
  447.   NEXTLINE;
  448.  
  449.  
  450.             /* Read common block info */
  451.  
  452.    READ_NUM(" comblocks",numblocks);
  453. #ifdef DEBUG_PROJECT
  454.  printf("read num blocks %d\n",numblocks);
  455. #endif
  456.    NEXTLINE;
  457.  
  458.    for(iblock=0; iblock<numblocks; iblock++) {
  459.      proj_com_info_in(fd,topfilename);
  460.    }
  461.    NEXTLINE;
  462.  
  463.  }/* end while(retval == 1) */
  464.  
  465.  if(retval != EOF) READ_ERROR;
  466.  
  467.  init_symtab();        /* Clear out local strspace */
  468. }
  469.  
  470. static char *prev_file_name="";/* used to reduce number of callocs */
  471.  
  472.             /* Read arglist info */
  473. PRIVATE void
  474. proj_arg_info_in(fd,filename,is_defn)
  475.     FILE *fd;
  476.     char *filename;        /* name of toplevel file */
  477.     int is_defn;
  478. {
  479.     char id_name[MAXNAME+1],module_name[MAXNAME+1],sentinel[6];
  480.     char file_name[MAXNAME+1];
  481.     char arg_name[MAXNAME+1];
  482.  
  483. #ifndef KEEP_ARG_NAMES
  484.     static char var[]="var",    /* text strings to use for now */
  485.             expr[]="expr";
  486. #endif
  487.     int id_class,id_type;
  488.     long id_size;
  489.     unsigned
  490.           id_used_flag,
  491.           id_set_flag,
  492.           id_invoked,
  493.           id_declared,
  494.           id_library_module,
  495.           future1,future2,future3;
  496.  
  497.     unsigned h;
  498.     Gsymtab *gsymt, *module;
  499.     unsigned alist_class,alist_type,alist_is_defn,alist_is_call,
  500.        alist_external_decl,alist_actual_arg;
  501.     unsigned alist_line, alist_topline;
  502.     long alist_size;
  503.     unsigned numargs,iarg,arg_num,arg_class,arg_type,arg_dims;
  504.     unsigned long arg_elts;
  505.     long arg_size;
  506.     unsigned            /* Flags for arguments */
  507.         arg_is_lvalue,
  508.         arg_set_flag,
  509.         arg_assigned_flag,
  510.         arg_used_before_set,
  511.         arg_array_var,
  512.         arg_array_element,
  513.         arg_declared_external,
  514.         arg_future_flag;    /* possible flag for future use */
  515.  
  516.     if(is_defn)
  517.     READ_STR(" entry",id_name); /* Entry point name */
  518.     else
  519.     READ_STR(" external",id_name); /* External name */
  520.     READ_NUM(" class",id_class); /* class as in symtab */
  521.     READ_NUM(" type",id_type); /* type as in symtab */
  522.     READ_LONG(" size",id_size); /* size as in symtab */
  523.     if(fscanf(fd," flags %d %d %d %d %d %d %d %d",
  524.           &id_used_flag,
  525.           &id_set_flag,
  526.           &id_invoked,
  527.           &id_declared,
  528.           &id_library_module,
  529.           &future1,&future2,&future3) != 8) READ_ERROR;
  530.     NEXTLINE;
  531.  
  532. #ifdef DEBUG_PROJECT
  533.  printf("read id name %s class %d type %d\n",
  534. id_name,id_class,id_type);
  535. #endif
  536.  
  537.                 /* Create global symtab entry */
  538.     h = hash_lookup(id_name);
  539.     if( (gsymt = hashtab[h].glob_symtab) == NULL) {
  540.       gsymt = install_global((int)h,id_type,class_SUBPROGRAM);
  541.       gsymt->size = id_size;
  542.     }
  543.     else if(is_defn)
  544.       gsymt->size = id_size;
  545.  
  546.         /* Set library_module flag if project file was created
  547.            with -lib mode in effect, or is now taken in -lib mode */
  548.     if(is_defn && (library_mode || id_library_module)) {
  549.       gsymt->library_module = TRUE;
  550.     }
  551.     if(is_defn)
  552.       gsymt->defined = TRUE;
  553.     if(id_used_flag)
  554.       gsymt->used_flag = TRUE;
  555.     if(id_set_flag)
  556.       gsymt->set_flag = TRUE;
  557.     if(id_invoked)
  558.       gsymt->invoked_as_func = TRUE;
  559.     if(id_declared)
  560.       gsymt->declared_external = TRUE;
  561.  
  562.    while(   fscanf(fd,"%5s",sentinel),
  563. #ifdef DEBUG_PROJECT
  564.  printf("sentinel=[%s]\n",sentinel),
  565. #endif
  566.      strcmp(sentinel,(is_defn?"defn":"call")) == 0) {
  567.       ArgListHeader *ahead;
  568.       ArgListElement *alist;
  569. #ifdef KEEP_ARG_NAMES
  570.       ArgListHeader *prev_ahead;
  571.       ArgListElement *prev_alist;
  572.       int prev_n;
  573. #endif
  574.  
  575.       NEXTLINE;
  576.  
  577.       READ_STR(" module",module_name);
  578.       READ_STR(" file",file_name);
  579.       READ_NUM(" line",alist_line); /* line number */
  580.       READ_NUM(" top",alist_topline); /* topfile line number */
  581.       READ_NUM(" class",alist_class);    /* class as in ArgListHeader */
  582.       READ_NUM(" type",alist_type); /* type as in ArgListHeader */
  583.       READ_LONG(" size",alist_size); /* size as in ArgListHeader */
  584.       if(fscanf(fd," flags %d %d %d %d",
  585.         &alist_is_defn,
  586.         &alist_is_call,
  587.         &alist_external_decl,
  588.         &alist_actual_arg) != 4) READ_ERROR;
  589.       NEXTLINE;
  590. #ifdef DEBUG_PROJECT
  591.  printf("read alist class %d type %d line %d\n",
  592. alist_class,alist_type,alist_line);
  593. #endif
  594.         /* Find current module in symtab. If not there, make
  595.            a global symtab entry for it. It will be filled
  596.            in eventually when processing corresponding entry.
  597.          */
  598.  
  599.       h = hash_lookup(module_name);
  600.       if( (module = hashtab[h].glob_symtab) == NULL) {
  601.     module = install_global((int)h,type_UNDECL,class_SUBPROGRAM);
  602.       }
  603.       if(module->internal_entry) {
  604.     warning(NO_LINE_NUM,NO_COL_NUM,
  605.         "entry point redefined as module");
  606.     msg_tail(module->name);
  607.     msg_tail(": redefinition ignored");
  608.       }
  609.       else {
  610.     if(is_defn) {
  611.       if(module != gsymt) {
  612. #ifdef DEBUG_PROJECT
  613.         printf("\nLinking entry %s to module %s",
  614.            gsymt->name,module->name);
  615. #endif
  616.         gsymt->internal_entry = TRUE;
  617.         gsymt->link.module=module; /* interior entry: link it to module */
  618.       }
  619.     }
  620.     else {            /* call: add to child list */
  621.         /* Avoid duplication on child list.  It will have just
  622.            been placed there on previous project-file entry,
  623.            so it will be the first child on the list.
  624.         */
  625. #ifdef DEBUG_PROJECT
  626.       printf("\nChild %s of module %s",
  627.          gsymt->name,module->name);
  628. #endif
  629.       if(module->link.child_list == NULL
  630.          || module->link.child_list->child != gsymt) {
  631.         ChildList *node=
  632.           (ChildList *)calloc(1,sizeof(ChildList));
  633. #ifdef DEBUG_PROJECT
  634.         printf(" linked in");
  635. #endif
  636.         node->child = gsymt;
  637.         node->next = module->link.child_list;
  638.         module->link.child_list = node;
  639.       }
  640. #ifdef DEBUG_PROJECT
  641.       else {
  642.         printf(" (duplicate)");
  643.       }
  644. #endif
  645.     }
  646.       }
  647.  
  648.       if(alist_is_defn || alist_is_call) {
  649.       READ_NUM(" args",numargs);
  650.       NEXTLINE;
  651.       }
  652.       else
  653.     numargs = 0;
  654.  
  655. #ifdef DEBUG_PROJECT
  656.  printf("read numargs %d\n",numargs);
  657. #endif
  658. /*
  659. **      if(!is_defn) {
  660. **    gsymt->used_flag = TRUE;
  661. **      }
  662. */
  663.                 /* Create arglist structure */
  664.       if(((ahead=(ArgListHeader *) calloc(1, sizeof(ArgListHeader)))
  665.                   == (ArgListHeader *) NULL) ||
  666.       (numargs != 0 &&
  667.           ((alist=(ArgListElement *) calloc(numargs,sizeof(ArgListElement)))
  668.                  == (ArgListElement *) NULL))){
  669.         oops_message(OOPS_FATAL,proj_line_num,NO_COL_NUM,
  670.                  "out of malloc space for argument list");
  671.       }
  672.  
  673.             /* Initialize arglist and link it to symtab */
  674.       ahead->type = type_byte(alist_class,alist_type);
  675.       ahead->size = alist_size;
  676.       ahead->numargs = (short)numargs;
  677.       ahead->arg_array = (numargs==0? NULL: alist);
  678.       ahead->module = module;
  679.       ahead->topfile = filename;
  680.             /* try to avoid reallocating space for same name */
  681.       ahead->filename =
  682.     (strcmp(file_name,filename)==0? filename:
  683.      (strcmp(file_name,prev_file_name)==0? prev_file_name:
  684.       (prev_file_name=new_global_string(file_name))));
  685.  
  686.       ahead->line_num = alist_line;
  687.       ahead->top_line_num = alist_topline;
  688.       ahead->is_defn = alist_is_defn;
  689.       ahead->is_call = alist_is_call;
  690.       ahead->external_decl = alist_external_decl;
  691.       ahead->actual_arg = alist_actual_arg;
  692.       ahead->next = prev_ahead = gsymt->info.arglist;
  693.       gsymt->info.arglist = ahead;
  694.       if(prev_ahead != NULL) {
  695.     prev_n = prev_ahead->numargs;
  696.     prev_alist = prev_ahead->arg_array;
  697.       }
  698.  
  699.             /* Fill arglist array from project file */
  700.       for(iarg=0; iarg<numargs; iarg++) {
  701.     READ_NUM(" arg",arg_num);    if(arg_num != iarg+1) READ_ERROR;
  702.     READ_ARG(" name",arg_name);
  703.     READ_NUM(" class",arg_class);
  704.     READ_NUM(" type",arg_type);
  705.     READ_LONG(" size",arg_size);
  706.     READ_NUM(" dims",arg_dims);
  707.     READ_LONG(" elts",arg_elts);
  708.     if(fscanf(fd," flags %d %d %d %d %d %d %d %d",
  709.         &arg_is_lvalue,
  710.         &arg_set_flag,
  711.         &arg_assigned_flag,
  712.         &arg_used_before_set,
  713.         &arg_array_var,
  714.         &arg_array_element,
  715.         &arg_declared_external,
  716.         &arg_future_flag) != 8) READ_ERROR;
  717.  
  718. #ifdef KEEP_ARG_NAMES
  719.             /* Economize storage by re-using previously allocated
  720.                space for same name in prior call if any */
  721.     alist[iarg].name = (prev_ahead != NULL && iarg < prev_n &&
  722.               strcmp(arg_name,prev_alist[iarg].name) == 0) ?
  723.                 prev_alist[iarg].name:
  724.                 new_global_string(arg_name);
  725. #else
  726.     if(strcmp(arg_name,expr) == 0) /* For now, just use "var" and "expr" */
  727.       alist[iarg].name = expr;
  728.     else
  729.       alist[iarg].name = var;
  730. #endif
  731.     alist[iarg].info.array_dim = array_dim_info(arg_dims,arg_elts);
  732.     alist[iarg].type = type_byte(arg_class,arg_type);
  733.     alist[iarg].size = arg_size;
  734.     alist[iarg].is_lvalue = arg_is_lvalue;
  735.     alist[iarg].set_flag = arg_set_flag;
  736.     alist[iarg].assigned_flag = arg_assigned_flag;
  737.     alist[iarg].used_before_set = arg_used_before_set;
  738.     alist[iarg].array_var = arg_array_var;
  739.     alist[iarg].array_element = arg_array_element;
  740.     alist[iarg].declared_external = arg_declared_external;
  741.     NEXTLINE;
  742. #ifdef DEBUG_PROJECT
  743.  printf("read arg num %d name %s\n",arg_num,arg_name);
  744. #endif
  745.       }
  746.  
  747.     }/* end while( sentinel == "defn"|"call") */
  748.  
  749.     if(strcmp(sentinel,"end") != 0) READ_ERROR;
  750.     NEXTLINE;
  751. }
  752.  
  753.  
  754. PRIVATE void
  755. proj_com_info_in(fd,filename)
  756.      FILE *fd;
  757.      char *filename;
  758. {
  759.     char id_name[MAXNAME+1],module_name[MAXNAME+1];
  760.     char file_name[MAXNAME+1];
  761.     char var_name[MAXNAME+1];
  762.     unsigned id_class,id_type;
  763.     unsigned            /* Flags in ComListHeader */
  764.         clist_any_used,
  765.         clist_any_set,
  766.         clist_saved,
  767.         clist_future;
  768.     unsigned clist_line,clist_topline;
  769.     unsigned numvars,prev_n,ivar,var_num,var_class,var_type,var_dims;
  770.     unsigned long var_elts;
  771.     unsigned            /* Flags for common variables */
  772.         var_used,
  773.         var_set,
  774.         var_used_before_set,
  775.         var_assigned,
  776.         var_future_4,
  777.         var_future_3,
  778.         var_future_2,
  779.         var_future_1;
  780.     long var_size;
  781.       int h;
  782.       Gsymtab *gsymt, *module;
  783.       ComListHeader *chead,*prev_chead;
  784.       ComListElement *clist,*prev_clist;
  785.  
  786.  
  787.     READ_STR(" block",id_name);
  788.     READ_NUM(" class",id_class);
  789.     READ_NUM(" type",id_type);
  790. #ifdef DEBUG_PROJECT
  791.  printf("read com name %s class %d type %d\n",
  792. id_name,id_class,id_type);
  793. #endif
  794.     NEXTLINE;
  795.  
  796.     READ_STR(" module",module_name);
  797.     READ_STR(" file",file_name);
  798.     READ_NUM(" line",clist_line);
  799.     READ_NUM(" top",clist_topline);
  800.     if(fscanf(fd," flags %d %d %d %d",
  801.         &clist_any_used,
  802.         &clist_any_set,
  803.         &clist_saved,
  804.         &clist_future) != 4) READ_ERROR;
  805.     NEXTLINE;
  806.  
  807.     READ_NUM(" vars",numvars);
  808. #ifdef DEBUG_PROJECT
  809.  printf("read module %s file %s",module_name,file_name);
  810.  printf(" flags %d %d %d %d line %d\n",
  811.     clist_any_used,
  812.     clist_any_set,
  813.     clist_saved,
  814.     clist_future,
  815.     clist_line);
  816. #endif
  817.     NEXTLINE;
  818.                 /* Create global symtab entry */
  819.     h = hash_lookup(id_name);
  820.     if( (gsymt = hashtab[h].com_glob_symtab) == NULL)
  821.       gsymt = install_global(h,(int)id_type,(int)id_class);
  822.  
  823.  
  824.                 /* Create arglist structure */
  825.     if(((chead=(ComListHeader *) calloc(1, sizeof(ComListHeader)))
  826.                   == (ComListHeader *) NULL) ||
  827.       (numvars != 0 &&
  828.           ((clist=(ComListElement *) calloc(numvars,sizeof(ComListElement)))
  829.                  == (ComListElement *) NULL))){
  830.         oops_message(OOPS_FATAL,proj_line_num,NO_COL_NUM,
  831.                  "out of malloc space for common list");
  832.       }
  833.  
  834.         /* Find current module in symtab. If not there, make
  835.            a global symtab entry for it.  This is bogus, since
  836.            all modules should have been defined previously. */
  837.  
  838.       h = hash_lookup(module_name);
  839.       if( (module = hashtab[h].glob_symtab) == NULL) {
  840.     (void)fprintf(stderr,"\nWarning-- something's bogus in project file\n");
  841.     module = install_global(h,type_UNDECL,class_SUBPROGRAM);
  842.       }
  843.  
  844.             /* Initialize arglist and link it to symtab */
  845.       chead->numargs = (short)numvars;
  846.       chead->line_num = clist_line;
  847.       chead->top_line_num = clist_topline;
  848.       chead->com_list_array = (numvars==0? NULL: clist);
  849.       chead->module = module;
  850.       chead->topfile = filename;
  851.       chead->any_used = clist_any_used;
  852.       chead->any_set = clist_any_set;
  853.       chead->saved = clist_saved;
  854.             /* try to avoid reallocating space for same name */
  855.       chead->filename =
  856.     (strcmp(file_name,filename)==0? filename:
  857.      (strcmp(file_name,prev_file_name)==0? prev_file_name:
  858.       (prev_file_name=new_global_string(file_name))));
  859.  
  860.       chead->next = prev_chead = gsymt->info.comlist;
  861.       gsymt->info.comlist = chead;
  862.       if(prev_chead != NULL) {
  863.     prev_n = prev_chead->numargs;
  864.     prev_clist = prev_chead->com_list_array;
  865.       }
  866.  
  867.             /* Fill comlist array from project file */
  868.     for(ivar=0; ivar<numvars; ivar++) {
  869.       READ_NUM(" var",var_num); if(var_num != ivar+1) READ_ERROR;
  870.       READ_STR(" name",var_name);
  871.       NEXTLINE;
  872.       READ_NUM(" class",var_class);
  873.       READ_NUM(" type",var_type);
  874.       READ_LONG(" size",var_size);
  875.       READ_NUM(" dims",var_dims);
  876.       READ_LONG(" elts",var_elts);
  877.     if(fscanf(fd," flags %d %d %d %d %d %d %d %d",
  878.         &var_used,
  879.         &var_set,
  880.         &var_used_before_set,
  881.         &var_assigned,
  882.         &var_future_4,
  883.         &var_future_3,
  884.         &var_future_2,
  885.         &var_future_1) != 8) READ_ERROR;
  886.       NEXTLINE;
  887. #ifdef DEBUG_PROJECT
  888.  printf("read name %s class %d type %d dims %d size %d\n",
  889. var_name,var_class,var_type,var_dims,var_size);
  890. #endif
  891.             /* Economize storage by re-using previously allocated
  892.                space for same name in prior decl if any */
  893.       clist[ivar].name = (prev_chead != NULL && ivar < prev_n &&
  894.               strcmp(var_name,prev_clist[ivar].name) == 0) ?
  895.                 prev_clist[ivar].name:
  896.                 new_global_string(var_name);
  897.  
  898.       clist[ivar].dimen_info = array_dim_info(var_dims,var_elts);
  899.       clist[ivar].type = type_byte(var_class,var_type);
  900.       clist[ivar].size = var_size;
  901.       clist[ivar].used = var_used;
  902.       clist[ivar].set = var_set;
  903.       clist[ivar].used_before_set = var_used_before_set;
  904.       clist[ivar].assigned = var_assigned;
  905.     }
  906. }/*proj_com_info_in*/
  907.  
  908.     /*  Function to read n-1 characters, or up to newline, whichever
  909.      *  comes first.  Differs from fgets in that the newline is replaced
  910.      *  by null, and characters up to newline (if any) past the n-1st
  911.      *  are read and thrown away.
  912.      *  Returns NULL when end-of-file or error is encountered.
  913.      */
  914. PRIVATE char *
  915. getstrn(s,n,fd)
  916.     char s[];
  917.     int n;
  918.     FILE *fd;
  919. {
  920.     int i=0,c;
  921.  
  922.     while( (c=getc(fd)) != '\n' ) {
  923.         if(c == EOF)
  924.             return NULL;
  925.  
  926.         if(i < n-1)
  927.             s[i++] = c;
  928.     }
  929.     s[i] = '\0';
  930.     return s;
  931. }
  932.